home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / getquo30.zip / PLOT.LST < prev    next >
File List  |  1992-12-22  |  5KB  |  159 lines
  1. ***** UTAH Fortran 1.0 (Mod 4) ** Compiling File: C:PLOT.FOR *****
  2.  
  3. 0001 OPTIONS X
  4.      C     PROGRAM PLOT.FOR
  5.      C
  6.      C  This program reads a stock data file and produces a candlestick chart
  7.      C  with High, Low, Close, and Volume.
  8.      C
  9.      C  INPUT.DAT Data line example:
  10.      C  | 9338     78.375    77.375   77.875  -0.500   5/14/92*|
  11.      C
  12. 0002       DIMENSION LINE(9),BUF(79),CLINE(14),FILE(3)
  13. 0003       REAL HIGH,LOW,CLSE,CHG,DATE,CHK
  14. 0004       INTEGER VOL,MO,DAY,TVOL,IYR
  15.      C
  16. 0005       IDY = 0
  17. 0006       IMO = 0
  18. 0007       THIGH = 0.0
  19. 0008       TLOW = 10000.0
  20. 0009       TVOL = 0
  21.      C
  22.      C  Open the input file
  23.      C
  24. 0010       CALL OPEN (2,'INPUT.DAT')
  25.      C
  26.      C  Initialize Charting Limits
  27.      C
  28. 0011       READ (2,1000,END=6) VOL,HIGH,LOW,CLSE,CHG,DATE,IYR
  29. 0012  1000 FORMAT (I5,3X,F8.3,2X,F8.3,1X,F8.3,1X,F7.3,2X,A5,1X,I2)
  30. 0013       DECODE (DATE,5,1001) MO,CHK,DAY
  31. 0014  1001 FORMAT (I2,A1,I2)
  32. 0015     5 READ (2,1000,END=6) VOL,HIGH,LOW,CLSE,CHG,DATE,IYR
  33. 0016       IF (HIGH .GT. THIGH) THIGH = HIGH
  34. 0017       IF (LOW .LT. TLOW) TLOW = LOW
  35. 0018       IF (VOL .GT. TVOL) TVOL = VOL
  36. 0019       GOTO 5
  37.      C
  38. 0020     6 REWIND 2
  39. 0021       FACT = (THIGH-TLOW)/55.0
  40. 0022       FVOL = FLOAT(TVOL)/18.0
  41.      C
  42.      C  Initialize Month and Day counters
  43.      C
  44. 0023       IDY = DAY
  45. 0024       IMO = MO-1
  46. 0025       CALL OPEN (3,'OUTPUT.CRT')
  47.      C
  48.      C  Main Loop Setup
  49.      C
  50. 0026    15 IDYS = 30
  51. 0027       IF ((IMO.EQ.1).OR.(IMO.EQ.3).OR.(IMO.EQ.5).OR.(IMO.EQ.7).OR.
  52.           *(IMO.EQ.8).OR.(IMO.EQ.10).OR.(IMO.EQ.12)) IDYS = 31
  53. 0028       IF (IMO.EQ.2) IDYS = 28
  54.      C
  55.      C  Main Loop
  56.      C
  57. 0029       DO 10 I=IDY,IDYS
  58. 0030    14 READ (2,1000,END=30) VOL,HIGH,LOW,CLSE,CHG,DATE
  59. 0031       DECODE (DATE,5,1001) MO,CHK,DAY
  60. 0032       IF (CHK.NE.'/     ') GOTO 14
  61. 0033    16 IF (MO.NE.IMO) THEN
  62. 0034           CALL CMNTH(IMO,MO,DAY)
  63. 0035           GOTO 16
  64. 0036       ENDIF
  65. 0037    17 IF (DAY .GT. I) THEN
  66. 0038           DO 18 K=1,79
  67. 0039    18     BUF(K) = '      '
  68. 0040           ENCODE (CLINE,79,1002) BUF
  69. 0041  1002 FORMAT (79A1)
  70.      C
  71.      C  Print the line
  72.      C
  73. 0042           WRITE (3,1003) CLINE
  74. 0043  1003 FORMAT (13A6,A1)
  75. 0044           WRITE (1,1003) CLINE
  76. 0045           I=I+1
  77. 0046           GOTO 17
  78. 0047       ENDIF
  79. 0048       IDY = DAY+1
  80. 0049       IMO = MO
  81.      C
  82.      C  Compute Chart Volume Positions
  83.      C
  84. 0050       ITEST = 0
  85. 0051       IF (FVOL.GT.0) ITEST = VOL/FVOL
  86. 0052       DO 11 N=1,20
  87. 0053       BUF(N) = '      '
  88. 0054    11 IF (N .LE. ITEST) BUF(N) = '-     '
  89.      C
  90.      C  Compute Chart Price Positions
  91.      C
  92. 0055       ILOW = IFIX((LOW-TLOW)/FACT)
  93. 0056       IHIGH = IFIX((HIGH-TLOW)/FACT)
  94. 0057       ICLOS = IFIX((CLSE-TLOW)/FACT)
  95. 0058       DO 12 N=1,59
  96. 0059       BUF(N+20) = '      '
  97. 0060    12 IF ((N .GT. ILOW) .AND. (N .LT. IHIGH))  BUF(N+20) = '-     '
  98. 0061       BUF(ILOW+20) = '|     '
  99. 0062       BUF(IHIGH+20) = '|     '
  100. 0063       BUF(ICLOS+20) = '+     '
  101. 0064       ENCODE (CLINE,79,1002) BUF
  102.      C
  103.      C  Print the line
  104.      C
  105. 0065       WRITE (3,1003) CLINE
  106. 0066    10 WRITE (1,1003) CLINE
  107. 0067       GOTO 15
  108.      C
  109.      C  Normal Exit
  110.      C
  111. 0068    30 CONTINUE
  112. 0069       CALL CLOSE (2)
  113. 0070       CALL CLOSE (3)
  114. 0071       STOP 'Normal exit'
  115. 0072       END
  116. ** Generated Code =  2051 (Decimal), 0803 (Hex) Bytes
  117.      
  118. 0001       SUBROUTINE CMNTH(IMO,MO,DAY)
  119.      C
  120. 0002       INTEGER IMO,MO,DAY
  121.      C
  122.      C  Check for last month
  123.      C
  124. 0003    10 IMO = IMO+1
  125. 0004       IF (IMO.EQ.13) IMO = 1
  126. 0005       IF (IMO.EQ.MO) THEN
  127. 0006           RMO = 'DEC'
  128. 0007           IF (IMO.EQ.1) RMO = 'JAN'
  129. 0008           IF (IMO.EQ.2) RMO = 'FEB'
  130. 0009           IF (IMO.EQ.3) RMO = 'MAR'
  131. 0010           IF (IMO.EQ.4) RMO = 'APR'
  132. 0011           IF (IMO.EQ.5) RMO = 'MAY'
  133. 0012           IF (IMO.EQ.6) RMO = 'JUN'
  134. 0013           IF (IMO.EQ.7) RMO = 'JLY'
  135. 0014           IF (IMO.EQ.8) RMO = 'AUG'
  136. 0015           IF (IMO.EQ.9) RMO = 'SEP'
  137. 0016           IF (IMO.EQ.10) RMO = 'OCT'
  138. 0017           IF (IMO.EQ.11) RMO = 'NOV'
  139. 0018           WRITE (1,1001) RMO
  140. 0019  1001 FORMAT ('************************************* ',A3,
  141.           *' *************************************')
  142. 0020           WRITE (3,1001) RMO
  143. 0021           RETURN
  144. 0022       ENDIF
  145. 0023       IDYS = 30
  146. 0024       IF ((IMO.EQ.1).OR.(IMO.EQ.3).OR.(IMO.EQ.5).OR.(IMO.EQ.7).OR.
  147.           *(IMO.EQ.8).OR.(IMO.EQ.10).OR.(IMO.EQ.12)) IDYS = 31
  148. 0025       IF (IMO.EQ.2) IDYS = 28
  149. 0026       DO 20 M=1,IDYS
  150. 0027       WRITE (1,1000) IMO,M
  151. 0028    20 WRITE (3,1000) IMO,M
  152. 0029  1000 FORMAT ('          no data for ',I2,'/',I2)
  153. 0030       GOTO 10
  154. 0031       END
  155. ** Generated Code =   952 (Decimal), 03B8 (Hex) Bytes
  156.  
  157.  
  158.        No Compile errors
  159.